;;; $Id: monitor.sld 70 2012-07-20 05:28:37Z alan.watson.f $

(define-library (oaxaca monitor)

  (export main)

  (import (scheme base)
          (scheme time)
          (scheme write))

  (import (oaxaca thread)
          (oaxaca wfc)
          (oaxaca wfs))

  (begin

    (define key-width 32)

    (define (display-key-value key value . rest)
      (display (string-pad-right key key-width #\space))
      (display ": ")
      (display value)
      (for-each
       (lambda (value)
         (display #\space)
         (display value))
       rest)
      (newline))

    (define (string-pad-left s w c)
      (if (> (string-length s) w)
        s
        (string-append (make-string (- w (string-length s)) c) s)))

    (define (string-pad-right s w c)
      (if (> (string-length s) w)
        s
        (string-append s (make-string (- w (string-length s)) c))))

    (define (number->decimal x w p sign?)
      (let* ((i (exact (floor (abs x))))
             (f (- (abs x) i))
             (f (exact (round (* f (expt 10 p)))))
             (i (if (= f (expt 10 p)) (+ i 1) i))
             (f (if (= f (expt 10 p)) 0 f))
             (s (string-append (number->string i)
                               "."
                               (string-pad-left (number->string f) p #\0)))
             (s (cond
                 ((negative? x) (string-append "-" s))
                 (sign? (string-append "+" s))
                 (else s)))
             (s (if w (string-pad-left s w #\space) s)))
        s))

    (define (clear)
      (display "\x1b;\x5b;\x48;\x1b;\x5b;\x32;\x4a;"))

    (define (space)
      (display #\space))

    (define start-second (current-second))

    (define (clock)
      (let* ((second (- (current-second) start-second))
             (hour (exact (floor (/ second 3600.0))))
             (second (- second (* 3600.0 hour)))
             (minute (exact (floor (/ second 60.0))))
             (second (- second (* 60.0 minute)))
             (decisecond (exact (floor (* second 10.0))))
             (second (quotient decisecond 10))
             (decisecond (remainder decisecond 10)))
        (when (< hour 10) (display "0"))
        (display hour)
        (display ":")
        (when (< minute 10) (display "0"))
        (display minute)
        (display ":")
        (when (< second 10) (display "0"))
        (display second)
        (display ".")
        (display decisecond)
        (display "\n")))

    (define (main)

      (clear)
      (clock)

(when #f
      (display "wfc:\n")
      (display-key-value "wfc-initialized" (wfc-initialized?))
      (display-key-value "wfc-command" (wfc-command))
      (display-key-value "wfc-modal?" (wfc-modal?))
      (apply display-key-value "wfc-modes"
             (map (lambda (mode) (number->decimal mode 6 3 #t)) (vector->list (wfc-modes))))
      (display-key-value "wfc-voltages" "")
      (let ((voltages (wfc-voltages)))
        (do ((i 0 (+ i 1)))
            ((= i 64) (newline))
          (display (number->decimal (vector-ref voltages i) 6 3 #t))
          (if (= (remainder i 10) 9)
            (newline)
            (space))))

      (display "wfs:\n")
      (display-key-value "wfs-initialized" (wfs-initialized?))
      (display-key-value "wfs-command" (wfs-command))
      (display-key-value "wfs-pixel-clock-frequency"
                         (string-append (number->decimal (/ (wfs-pixel-clock-frequency) 1e6) #f 1 #f)
                                        "e6"))
      (display-key-value "wfs-frame-frequency"
                         (number->decimal (wfs-frame-frequency) #f 2 #f))
      (display-key-value "wfs-min-frame-frequency"
                         (number->decimal (wfs-min-frame-frequency) #f 2 #f))
      (display-key-value "wfs-max-frame-frequency"
                         (number->decimal (wfs-max-frame-frequency) #f 2 #f))
      (apply display-key-value "wfs-window"
             (call-with-values wfs-window list))
      (display-key-value "wfs-ao-gain"
                         (number->decimal (wfs-ao-gain) #f 2 #f))

      (thread-sleep! 0.1))
      (main))))
